Technotools/Technotools (Chestnut CD-ROM)(1993).ISO/lantools/os2bbshl/os2bbs.cmd

Text File | 1992-08-13 | 20.7 KB | 832 lines

/**
***  This will logon to IBMLink and provide the requested services.
***  ────────────────────────────────────────────────────────────────────
***  This REXX exec is submitted automatically on a daily basis to login
***  and download the new messages on the BBS.  The code that automates
***  the timed submission is Chron from Hilbert Computing.  Hilbert
***  can be reached at the address and BBS number listed below:
***
***       Hilbert Computing
***       1022 N. Cooper
***       Olathe, KS 66061
***       Voice:  [phone]
***       BBS:    [phone]
**/

arg Function Pswd . '(' Options

call ParseOptions Options

/* Set up global values */

Host.             = ''
Host.Session      = 'D'
Host.Application  = 'IBMLink'
Host.Applid       = 'IBM0MON2'
Host.Account      = 'xxxx'
Host.Userid       = 'yyyyyyy'
Host.Logmode      = 'PC3270M2'
Host.Password     = Pswd
Host.OpSys        = 'VM'

Bbs.              = ''            /* List of the BBS forums to visit */
Bbs.Forum.0       = 10
Bbs.Forum.1       = 'OS2PRG'
Bbs.Forum.2       = 'OS2PMPGM'
Bbs.Forum.3       = 'OS2TLKIT'
Bbs.Forum.4       = 'C-SET2'
Bbs.Forum.5       = 'OS2REXX'
Bbs.Forum.6       = 'OS2TCPIP'
Bbs.Forum.7       = 'OS2WPS'
Bbs.Forum.8       = 'OS2DOS'
Bbs.Forum.9       = 'OS2DBM'
Bbs.Forum.10      = 'OS2LAN'

call LoadFunctions
call HapiConnect

if Opt.Logon then
   call HostLogon

call Os2bbs Function

if Opt.Logon then
   call HostLogoff

call HapiDisconnect
exit


/**
*** ┌──────────────────────────────────────────────────────────────────────┐
*** │                        Misc Support Functions                        │
*** └──────────────────────────────────────────────────────────────────────┘
**/

ParseOptions: procedure expose Opt.
   /**
   ***  This will parse the options passed and return the values in the stem
   ***  variable opt.
   **/

   arg opt

   /* Set defaults */

   Opt.      = ''
   Opt.Logon = 1

   do i = 1 to words(opt)
      option = word(opt, i)
      parse upper var option option
      select
         when option = "LOGON"   then Opt.Logon = 1
         when option = "NOLOGON" then Opt.Logon = 0
         when option = "NOLOG"   then Opt.Logon = 0
         otherwise
            say "Warning: Unrecognized option" option". It was ignored"
      end /* select */
   end
   return


LoadFunctions: procedure
   /**
   ***  This will load all of the DLLs that are used by this exec.
   **/

   if RxFuncQuery('HLLAPI') then
      call RxFuncAdd 'HLLAPI','SAAHLAPI','HLLAPISRV'

   call RxFuncAdd 'SysLoadFuncs', 'RexxUtil', 'SysLoadFuncs'
   call SysLoadFuncs
   return


GetPassword: procedure
   /**
   ***  This will grab keystrokes and enter them back as '*' characters
   **/

   Password = ''
   Key = SysGetKey('NoEcho')
   do while c2x(Key) <> '0D'
      select
         when c2x(Key) = '08' then
            Password = left(Password, (length(password)-1))
         otherwise
            Password = Password || Key
      end /* select */
      Key = SysGetKey('NoEcho')
   end
   say "Password Received."
   return Password


/**
*** ┌──────────────────────────────────────────────────────────────────────┐
*** │                          OS/2 BBS Routines                           │
*** └──────────────────────────────────────────────────────────────────────┘
**/

Os2bbs: procedure expose Host. Bbs.
   /**
   ***  This routine will download information on the OS/2 BBS on IBMLink.
   ***  it will either grab the NEW information or ALL information and
   ***  store it in a local file.
   ***
   ***  On Entry:  IBMLink Main Menu
   ***  On Exit:   IBMLink Main Menu
   ***
   **/

   arg Scope .

   /* Get to the main menu */

   code = hllapi('Sendkey', '@0OS2BBS@E')
   code = HostWaitFor(120, 'Main Menu')
   if code = -1 then
      call HostError

   say "OS/2 BBS Main Menu"

   /* Get to the Forums */

   code = hllapi('Sendkey', '@0@E')
   rc = hllapi('Wait')

   do i = 1 to Bbs.Forum.0
      Bbs.FHandle = Open(Bbs.Forum.i'.BBS', 'Append')
      call Os2bbsVisitForum Bbs.Forum.i Scope
      call lineout Bbs.FHandle, copies('═', 79)
      Bbs.FHandle = Close(Bbs.FHandle)
   end

   /* Exit the OS/2 BBS and get back to IBMLink */

   call Os2bbsExit
   return


Os2bbsExit: procedure
   /**
   ***  This will exit the user from the OS2BBS appliction on IBMLink
   **/


   say "Exiting the OS/2 BBS"

   Position = hllapi('Search_ps',' eXit',1)
   if Position <> 0 then
      do
      code = hllapi('Set_cursor_pos', (Position-2))
      code = hllapi('Sendkey', '@E')
      code = hllapi('Wait')
      end

   /* We should now be at the main menu */

   code = hllapi('Sendkey', '@3')
   code = hllapi('Wait')
   code = HostWaitFor(45, 'Press PF3 again to CONFIRM your request.')
   code = hllapi('Sendkey', '@3')
   code = hllapi('Wait')
   return


Os2bbsVisitForum: procedure expose Screen. Host. Bbs.
   /**
   ***  This will visit an OS/2 BBS forum and grab either the NEW posts
   ***  or ALL of the posts based on the Scope passed.
   ***
   ***  On Entry: OS/2 Bulletin Board Topics panel
   ***  On Exit:  OS/2 Bulletin Board Topics panel
   **/

   parse arg Forum Scope .

   say "Visiting the" Forum "forum to download" Scope "messages."

   /* Get a screen shot */

   call HostScreenToStem

   /* Find out how many panels there are */

   parse var Screen.2 'Panel' PanelCurrent 'of' PanelMax

   /* Make sure we are on the first panel */

   do Panel = (PanelCurrent - 1) to 1 by -1
      call HostPageUp
   end

   /* Scan the screen(s) for the requested forum */

   FoundRow = 0
   do Panel = 1 to PanelMax while FoundRow = 0
      do i = 9 to (Screen.Rows - 2) while FoundRow = 0
         if pos(Forum, Screen.i) > 0 then
            FoundRow = i
      end /* row loop */

      if FoundRow = 0 then
         call HostPageDown
   end /* panel loop */

   if FoundRow = 0 then
      do
      say "Forum '"Forum"' not found on the IBMLink OS/2 BBS."
      return
      end

   /* If we get here, then we know the row on the current screen where */
   /* the desired forum is.   Put the cursor there and press Enter     */

   code = HostEnterXY(2, FoundRow)

   /* Check to see what the scope is.  If ALL notes are requested, then */
   /* tab down to the next spot and hit enter, otherwise just hit enter */

   if Scope = 'ALL' then
      do
      code = hllapi('Sendkey', '@T@E')
      rc= hllapi('Wait')
      end
   else
      do
      code = hllapi('Sendkey', '@E')
      rc= hllapi('Wait')

      /* Make a quick check to see if there are no new entries */

      call HostScreenToStem
      StatusLine = Screen.Rows - 1;
      if pos("You have seen all the", Screen.StatusLine) = 0 then
         do
         call Os2bbsPullEntries

         /* Go back to the forum menu */

         code = hllapi('Sendkey', '@3')
         code = hllapi('Wait')
         end
      end

   /* See if there are any replies queued to be uploaded to the OS/2 BBS */

   if Exists(Forum'.rpl') then
      call Os2bbsUploadReplies Forum

   /* Get back to the Topics panel */

   code = hllapi('Sendkey', '@3')
   code = hllapi('Wait')
   return


Os2bbsPullEntries: procedure expose Host. Bbs.
   /**
   ***  This will cycle through all of the notes in the list and place
   ***  them in a file.
   ***
   ***  On Entry: Forum Entries
   ***  On Exit:  Forum Entries
   **/

   say "Pulling entries."

   call HostScreenToStem

   /* Pull the number of panels of entries */

   parse var Screen.2 'Panel' PanelCurrent 'of' PanelMax
   do Panels = 1 to PanelMax

      /* Read each individual note */

      do Row = 9 to (Screen.Rows - 2) while strip(Screen.Row) <> ""
         code = hllapi('Sendkey', '@E')
         code = hllapi('Wait')
         call Os2bbsReadEntry Forum
         code = hllapi('Sendkey', '@T')
      end

      if Panels <> PanelMax then
         call HostPageDown
   end /* Panels */
   return


Os2bbsReadEntry: procedure expose Host. Bbs.
   /**
   ***  This will cycle through all of the notes in the list and place
   ***  them in a file.
   ***
   ***  On Entry: Text for a single note
   ***  On Exit:  Forum Entries
   **/

   parse arg Forum .

   call HostScreenToStem

   call lineout Bbs.FHandle, copies('═', 79)

   /* Pull the number of panels of entries */

   parse var Screen.2 'Panel' PanelCurrent 'of' PanelMax
   do Panels = 1 to PanelMax

      /* Find the last non-blank line */

      do Row = (Screen.Rows - 1) to 3 by -1 while strip(Screen.Row) = ""
         nop
      end
      LastRow = Row

      /* Write the lines to the forum file */

      do Row = 3 to LastRow
         call lineout Bbs.FHandle, strip(Screen.Row, 'Trailing')
      end

      if Panels <> PanelMax then
         call HostPageDown
   end /* Panels */

   /* Exit back to the Forum Entries */

   code = hllapi('Sendkey', '@3')
   code = hllapi('Wait')
   return


Os2bbsUploadReplies: procedure expose Host. Bbs.
   /**
   ***  This routine if called if there is a reply file for this forum.
   ***  It will upload the information into the forum as a new note.
   ***
   ***  On Entry: Forum Menu
   ***  On Exit:  Forum Menu
   **/

   arg Forum .

   say "Uploading replies to the" Forum "forum."

   /* Open the replies file */

   ReplyFile = Open(Forum'.rpl', 'READ')
   if ReplyFile = '' then
      return

   /* Skip the first line of the file (separator line) */

   line = linein(ReplyFile)

   /* Find the start of the reply */

   do while(lines(ReplyFile) > 0)
      call Os2bbsReplyToStem ReplyFile
      call Os2bbsUploadReply
   end
   code = Close(ReplyFile)
   '@copy'  ReplyFile '*.snt'
   '@erase' ReplyFile
   return


Os2bbsReplyToStem: procedure expose Reply.
   /**
   ***  This will load a single reply into a stem variable
   **/

   arg ReplyFile

   line = linein(ReplyFile) /* Skip the forum line */
   line = linein(ReplyFile) /* Should be the subject line */

   Reply. = ''

   parse var line . 'Subject: ' Reply.Subject

   i = 1
   line = linein(ReplyFile)
   do while(lines(ReplyFile) > 0) & (pos("══════════════════════", line) = 0)
      Reply.i = line
      i = i + 1
      line = linein(ReplyFile)
   end /* while */

   if pos("══════════════════════", line) = 0 then
      Reply.0 = i - 1
   else
      Reply.0 = i
   return


Os2bbsUploadReply: procedure expose Host. Bbs. Reply.
   /**
   ***  This routine if called if there is a reply file for this forum.
   ***  It will upload the information into the forum as a new note.
   ***
   ***  On Entry: Forum Menu
   ***  On Exit:  Forum Menu
   **/


   call HostScreenToStem

   /* Look for the correct line containing the menu selection for */
   /* submitting a new item                                       */

   do Row = 3 to Screen.Rows while pos("Submit A New Item", Screen.Row) = 0
      nop
   end
   if Row = Screen.Row then
      do
      say "Error: Expected to find a 'Submit New Item' menu and didn''t."
      return
      end

   code = HostEnterXY(2, Row)

   /* We are now at the append screen */

   code = hllapi('Sendkey', Reply.Subject'@T@E')

   /* We are now at the text entry screen */

   Row = 3
   do i = 1 to Reply.0
      code = hllapi('Sendkey', substr(Reply.i, 1, 78)'@T')

      /* Page down if we have filled a screen */

      if Row >= (Screen.Rows - 2) then
         do
         call HostPageDown
         Row = 3
         end

      Row = Row + 1
   end

   /* Return from the edit screen */

   code = hllapi('Sendkey', '@3')
   code = hllapi('Wait')

   /* Tab twice to the append mark and press enter */

   code = hllapi('Sendkey', '@T@T@E')
   code = hllapi('Wait')
   return



/**
*** ┌──────────────────────────────────────────────────────────────────────┐
*** │                            Host Routines                             │
*** └──────────────────────────────────────────────────────────────────────┘
**/

HostEnterXY: procedure expose Host.
   /**
   ***  This will position the cursor at a row and column and press the
   ***  Enter key.
   **/

   parse arg x, y .
   rcode = HostCursorXY(x,y)
   code = hllapi('Sendkey', '@E')
   rcode = hllapi('Wait')
   return code


HostCursorXY: procedure expose Host.
   /**
   ***  This will position the cursor at the proper row and column
   **/
   parse arg x, y .

   Position = hllapi('Convert_pos', Host.Session, x, y)
   code = hllapi('Set_cursor_pos', Position)
   return code


HostPageDown: procedure expose Screen. Host.
   /**
   ***  This will page down to the next screen and refresh the Screen.
   ***  stem variable with the new screen.
   **/

   code = hllapi('Sendkey', '@8')
   rc = hllapi('Wait')
   call HostScreenToStem
   return

HostPageUp: procedure expose Screen. Host.
   /**
   ***  This will page up to the previous screen and refresh the Screen.
   ***  stem variable with the new screen.
   **/

   code = hllapi('Sendkey', '@7')
   rc = hllapi('Wait')
   call HostScreenToStem
   return


HostScreenToStem: procedure expose Host. Screen.
   /**
   ***  This will get the current screen and break it into the stem
   ***  variable called Screen.
   **/

   call HostGetScreenSize
   PresSpace = hllapi('Copy_PS_to_str', 1, (Screen.Rows * Screen.Cols))

   do i = 1 to Screen.Rows
      Screen.i = left(PresSpace, Screen.Cols)
      PresSpace = substr(PresSpace, Screen.Cols+1)
   end
   return


HostGetScreenSize: procedure expose Host. Screen.
   /**
   ***  This will fill the stem variable with the number of rows and
   ***  columns in the current screen.
   **/

   SessionStatus = hllapi('Query_session_status', Host.Session)
   Screen.Rows = c2d(reverse(substr(SessionStatus, 12, 2)))
   Screen.Cols = c2d(reverse(substr(SessionStatus, 14, 2)))
   return


HostError: procedure expose Host.
   /**
   ***  This will handle unexpected response errors from the host session
   **/

   arg code .

   select
      when code = 1001 then say 'Host could not process QUERY TIME command.'
      when code = 1002 then say 'Can''t synch time on this host operating system.'
      when code = 1003 then say 'Don''t know how to logon to this host operating system.'
      otherwise             say 'Unexpected response from host.'
   end /* select */
   call HapiDisconnect
   exit


HostLogon: procedure expose Host.
   /**
   ***  This will log the use on to the host.
   **/


   call HostLogonClMenu

   if Host.Logmode = '' then
      Logmode = ''
   else
      Logmode = 'M('Host.Logmode')'

   rc = hllapi('Sendkey', '/L' Host.Applid Host.Userid Logmode'@E')
   rc = hllapi('Wait')

   do while Host.Password = ''
      say 'Enter the password for' Host.Applid '['Host.Application']'
      Host.Password = GetPassword()
   end

   say "Logging on."

   call HostEnterIBMLinkInfo
   return


HostLogoff: procedure expose Host.
   /**
   ***  This will log off from the host assuming that the first valid
   ***  entry field will support a logoff command.  This does no error
   ***  checking or screen validation.
   **/

   say "Logging off."

   rc = hllapi('Sendkey', '@0LOGOFF@E')
   rc = hllapi('Wait')
   return


HostEnterIBMLinkInfo: procedure expose Host.
   /**
   ***   This will enter the account, userid, password and service (IBMLINK)
   ***   to connect to the IBMLink main menu
   ***
   ***   On Entry:  CL/Menu
   ***   On Exit:   IBMLink Main Menu
   **/

   code = HostWaitFor(60, 'I N F O R M A T I O N     N E T W O R K')
   if code = -1 then
      call HostError

   code = hllapi('Sendkey', '@0'Host.Account'@T'Host.Userid)
   if (length(Host.Userid) < 7) then
      code = hllapi('Sendkey', '@T')
   code = hllapi('Sendkey', Host.Password'@TIBMLink@E')

   code = HostWaitFor(180, 'MAINMENU')
   if code = -1 then
      call HostError
   return


HostLogonClMenu: procedure expose Host.
   /**
   ***  This will check to see if the session is at the Quality logo
   ***  or the CLMenu screen or the "Press Enter..." one-liner screen.
   ***  Upon exit, you will be placed at the CL/Menu screen.
   **/

   pos = hllapi('Search_ps','CLM095I - PRESS ENTER OR PF KEY TO GET CL/MENU DISPLAY',1)
   if pos <> 0 then
      do
      rc=hllapi('Sendkey', '@E')
      rc=hllapi('Wait')
      end

   pos = hllapi('Search_ps','To start, enter MENU ====>',1)
   if pos <> 0 then
      do

      /* Enter the menu command */

      call HapiClear
      rc=hllapi('Sendkey', 'MENU@E')
      rc=hllapi('Wait')
      end

   /* Wait for the CL/Menu main screen to appear.  If it doesn't after */
   /* a few retries, bomb out.                                         */

   code = HostWaitFor(10, '/L - LOGON TO VTAM APPLICATION')
   if code = -1 then
      call HostError
   return


HostWaitFor: procedure expose Host.
   /**
   ***  This will wait for a certain string to appear on the screen.  Some
   ***  applications will unlock the keyboard while processing (e.g. most
   ***  VM applictions), so the HLLAPI code can't just wait for keyboard
   ***  unlock.  This will check for a particular character string before
   ***  returning.  If the string doesn't appear within the number of
   ***  seconds passed, it will return a '-1' return code.
   **/

   parse arg MaxSeconds, SearchString

   sleeps = 0
   do until pos <> 0
      pos=hllapi('Search_ps', SearchString, 1)
      call SysSleep 1
      sleeps = sleeps + 1

      if sleeps >= MaxSeconds then
         return -1
   end /* until */
   return 0


/**
*** ┌──────────────────────────────────────────────────────────────────────┐
*** │                           HLLAPI Routines                            │
*** └──────────────────────────────────────────────────────────────────────┘
**/

HapiError: procedure expose Host.
   /**
   ***
   **/
   arg code verb .

   say 'Return code' code 'from HLLAPI command:' verb'.'
   call HapiDisconnect
   exit


HapiDisconnect: procedure expose Host.
   /**
   ***  This will disconnect the HLLAPI session from the host
   **/
   call hllapi 'disconnect'
   call hllapi 'reset_system'
   return


HapiConnect: procedure expose Host.
   /**
   ***  This will connect to the host session and make sure the keyboard is
   ***  unlocked.
   **/

   rc = hllapi('Connect',Host.Session)
   if rc <> 0 then
      call HapiError rc 'Connect'

   rc=hllapi('Wait')
   if rc <> 0 then
      call HapiError rc 'Wait'
   return


HapiClear: procedure expose Host.
   /**
   ***  This will clear the host screen
   **/
   rc=hllapi('Sendkey', '@C')    /* Send a clear key */
   rc=hllapi('Wait')             /* Wait for clear key to complete */
   return

/**
*** ┌──────────────────────────────────────────────────────────────────────┐
*** │ OPEN                                                                 │
*** └──────────────────────────────────────────────────────────────────────┘
**/
Open: procedure

   arg file, mode

   FileExists = stream(file,c,'QUERY EXIST')

   /* Take special actions based on certain open modes */

   select
      when Mode = 'READ'   then
         OpenMsg = stream(file, c, 'OPEN READ')
      when Mode = 'WRITE'  then
         do
         if (FileExists <> '') then
            do
            if (mode = 'WRITE') then
               '@erase' file
            file = FileExists
            end
         OpenMsg = stream(file, c, 'OPEN WRITE')
         end
      when Mode = 'APPEND' then
         OpenMsg = stream(file, c, 'OPEN WRITE')
      otherwise
         do
         say 'Error: Invalid open mode' mode'.'
         return ''
         end
   end /* select */

   if (OpenMsg <> 'READY:') then
      do
      say 'Error: Open failure on' file'.' message
      return ''
      end
   return file

/**
*** ┌──────────────────────────────────────────────────────────────────────┐
*** │ CLOSE                                                                │
*** └──────────────────────────────────────────────────────────────────────┘
**/
Close: procedure

   arg file
   message = stream(file,c,'CLOSE')
   if (message \= 'READY:') & (message \= '') then
      do
      say 'Error: Close failure on' file'.' message
      exit
      end
   return file
/**
*** ┌──────────────────────────────────────────────────────────────────────┐
*** │ EXISTS                                                               │
*** └──────────────────────────────────────────────────────────────────────┘
**/
Exists: procedure

   arg file

   file = stream(file,c,'QUERY EXIST')
   if (file = '') then
      return 0
   else
      return 1